; Dialog for doing arithmetic transformations via a dialog box.
; (c) Pedro Valero 21-4-2003
         

;falta por hacer que añadir una constante vaya por separado de combinar variables y todo eso.
;También. Hay que crear un diálogo para elegir la variable que es dividida por qué variable y todo eso.


(defproto arithmetic-transf-object-proto '() () transf-object-proto)

(defmeth arithmetic-transf-object-proto :isnew (&rest args)
  (apply #'call-next-method args))

(defmeth arithmetic-transf-object-proto :options () t)

 (defmeth arithmetic-transf-object-proto :analysis ()

    (let* (
           (transf-object self)
           (data-ob *current-data*)
           (data-matrix-column-list (column-list (send data-ob :active-data-matrix '(numeric))))
           (labels (send data-ob :active-labels))
           (variables-list (send data-ob :active-variables '(numeric)))
           (length-list-items (if (> (length variables-list)) 100 (length variables-list 100)))
           (list-variables (send list-item-proto :new (combine variables-list (repeat "" length-list-items)) :columns 2))
           (list-variables-selected1 
            (send list-item-proto :new (repeat "" length-list-items) 
                  ))
           (list-variables-selected2 (send list-item-proto :new (repeat "" length-list-items)))
           (list-results (send list-item-proto :new (repeat ""  length-list-items)))
           (operators-list (list "+" "-" "*" "/" "sum"))
           (operators (send choice-item-proto :new operators-list))
           (white (send text-item-proto :new ""))
           (res-variables)
           (num-variables (length variables-list))
           (go-right-button1 
            (send button-item-proto :new ">"
                  :action #'(lambda () (let* ((selection (send list-variables :selection))
                                              ;(value (select (send list-variables :slot-value 'list-data) selection))
                                              (value (position "" (send list-variables-selected1 :slot-value 'list-data) 
                                                               :test #'equal))
                                              )
                                         (when 
                                          (and selection (not (equal value "")))
                                          
                                          (send list-variables-selected1 :set-text
                                                ; (send list-variables :selection)
                                                value
                                                (select (send list-variables :slot-value 'list-data)
                                                        (send list-variables :selection)))
                                          (send list-variables :set-text 
                                                (send list-variables :selection)
                                                "")
                                          (send list-variables :selection nil)
                                          
                                          )))))
           (go-left-button1 
            (send button-item-proto :new "<"
                  :action #'(lambda () 
                              (let* ((selection (send list-variables-selected1 :selection))
                                     (value (position 
                                             (select (send list-variables-selected1 :slot-value 'list-data) selection)
                                           variables-list :test #'equal))
                                     ;(value (position "" (send list-variables :slot-value 'list-data) 
                                                       ;                                :test #'equal))
                                     )
                                (when 
                                 (and selection (not (equal value "")))
                                 
                                 (send list-variables :set-text
                                       ; (send list-variables-selected1 :selection)
                                       value
                                       (select (send list-variables-selected1 :slot-value 'list-data) 
                                               (send list-variables-selected1 :selection)))
                                 (send list-variables-selected1 :set-text 
                                       (send list-variables-selected1 :selection)
                                       "")
                                 (send list-variables-selected1 :selection nil)
                                 
                                 )))))
           (go-right-button2 (send button-item-proto :new ">"
                                   :action #'(lambda () 
                                               (let* ((selection (send list-variables :selection))
                                                      ;(value (select (send list-variables :slot-value 'list-data) selection))
                                                      (value (position "" (send list-variables-selected2 :slot-value 'list-data) 
                                                                       :test #'equal))
                                                    )
                                                 (when 
                                                  (and selection (not (equal value "")))
                                                  
                                                  (send list-variables-selected2 :set-text
                                                        ; (send list-variables :selection)
                                                        value
                                                        (select (send list-variables :slot-value 'list-data)
                                                                (send list-variables :selection)))
                                                  (send list-variables :set-text 
                                                         (send list-variables :selection)
                                                        "")
                                                  
                                                  (send list-variables :selection nil)
                                                  )))))
                                 
           (go-left-button2 (send button-item-proto :new "<"
                                  :action #'(lambda () 
                                              (let* ((selection (send list-variables-selected2 :selection))
                                                     (value (position 
                                                             (select (send list-variables-selected2 :slot-value 'list-data) selection)
                                           variables-list :test #'equal))
                                                     ;  (value (position "" (send list-variables :slot-value 'list-data) 
                                                                         ;                                  :test #'equal))
                                                     )
                                                (when 
                                                 (and selection (not (equal value "")))
                                                 (send list-variables :set-text
                                  ; (send list-variables-selected2 :selection)
                                                       value
                                                       (select (send list-variables-selected2 :slot-value 'list-data)  
                                            (send list-variables-selected2 :selection)))
                                                 (send list-variables-selected2 :set-text 
                                                       (send list-variables-selected2 :selection)
                                    "")
                                                 (send list-variables-selected2 :selection nil)
                                                 )))))
           (OK (send button-item-proto :new "OK" 
                     :action #'(lambda () 
                                (send (send OK :dialog) :close)
                                 (data (send transf-object :name)
                                   :created   (- (send *desktop* :num-icons) 1)
                                       :title     (concatenate 'string "Arith-" (send transf-object :title))
                                       :labels    labels
                                       :data      (combine (transpose (apply 'bind-rows data-matrix-column-list)))
                                       :variables variables-list
                                       :freq      (send transf-object :freq)
                                       :row-label (when  (send transf-object :freq) (first (send (send transf-object :freq) :freq-way-names)))
                                       :column-label (when (send transf-object :freq) (second (send (send transf-object :freq) :freq-way-names)))
                                       :types     (repeat '(numeric) (length variables-list))
                                       )
                                 )))
               
               (add-variable (send button-item-proto :new "Add-variables" 
                                   :action #'(lambda () 
                               (let* (
                                      (operator-string (select operators-list (send operators :value)))
                                      (operator (read-from-string operator-string))
                                      (n (length (first data-matrix-column-list)))
                                      (test (unless (= (length variables-list) 
                                                       (length (remove-duplicates variables-list :test #'equal)))
                                                    (error-message "There are two variables with the same name in this dataset. This may produce errors in the variables produced. Check carefully the results")))

                                      (group1 (mapcar #'(lambda (var) (position var variables-list :test #'equal))
                                                      (remove "" (coerce (send list-variables-selected1 
                                                                               :slot-value 'list-data) 'list)
                                                       :test #'equal)))
                              
                                      (group2 (mapcar #'(lambda (var) (position var variables-list :test #'equal))
                                                      (remove "" (coerce (send list-variables-selected2 
                                                                               :slot-value 'list-data) 'list)
                                                       :test #'equal)))
                                  
                                      (set1 (select data-matrix-column-list group1))
                                               
                                      (set2 (select data-matrix-column-list group2))
                                               
                                      (variables1 (select variables-list group1))
                                      (variables2 (select variables-list group2))
                                      
                                      )
                                 (cond ((and (or group1 group2) (equal operator-string "sum"))
                                        
                                        (let* ((name-var (introduce-symbol  (remove 'nil (combine variables1 variables2)) "+"))
                                               (result-var (apply '+ (append set1 set2))))
                                          
                                          (setf data-matrix-column-list (append data-matrix-column-list (list result-var)))
                                          (setf variables-list (combine variables-list name-var))
                                          (setf num-variables (1+ num-variables))

                                         (mapcar #'(lambda (i name-var) 
                                                  (send list-variables :set-text i name-var)
                                                  (send list-variables-selected1 :set-text i "")
                                                  (send list-variables-selected2 :set-text i "")
                                                  )
                                              (iseq num-variables) variables-list)
                                        
                                          ))
                                        
                                   ((and group1 group2)
                                    (let* ((result-vars
                                           (split-list  
                                            (combine (mapcar #'(lambda (s1) 
                                                                 (mapcar #'(lambda (s2) (map-elements operator s1 s2))
                                                                         set2))
                                                             set1))
                                            n))
                                           
                                           (result-vars (mapcar #'(lambda (var) (coerce var 'vector)) result-vars))
                                           (result-name-vars
                                            (combine 
                                             (mapcar #'(lambda (v1) 
                                                         (mapcar #'(lambda (v2) (strcat v1 operator-string v2))
                                                                 variables2))
                                                     variables1))))

                                      (setf data-matrix-column-list (append data-matrix-column-list result-vars))
                                     
                                     (mapcar #'(lambda (name-var)
                                                ; (send list-variables :set-text 
                                                 ;      num-variables
                                                  ;     name-var)
                                                 (setf variables-list (combine variables-list name-var))
                                                 (setf num-variables (1+ num-variables))
                                                 ) 
                                             result-name-vars)
                                      ;clear boxes
                                      (mapcar #'(lambda (i name-var) 
                                                  (send list-variables :set-text i name-var)
                                                  (send list-variables-selected1 :set-text i "")
                                                  (send list-variables-selected2 :set-text i "")
                                                  )
                                              (iseq num-variables) variables-list))))
                                 
                                   ))))
         
         (cancel (send button-item-proto :new "Cancel" :action #'(lambda () (send (send cancel :dialog) :close))))
         
         )
    
    (send dialog-proto :new (list 
                             (list (list list-variables)
                                   (list (list go-right-button1) 
                                         (list go-left-button1)) 
                                   (list list-variables-selected1)
                                   (list operators )
                                   (list (list go-right-button2) 
                                         (list go-left-button2))
                                   (list list-variables-selected2)
                                   )
                             (list ok cancel add-variable)))
   
    ))
   
 
    

(defun arithmetic-transformations
  (&key 
   (data       current-data)
   (dialog     t)
   (name       "Sum")
   (title      nil)
   )
  (send arithmetic-transf-object-proto :new 9 data title name dialog))



#|(setf arithmetic-menu-item
      (send menu-item-proto :new "Arithmetic"		
            :action #'(lambda () (arithmetic-transformations))))



(send *trans-menu* :append-items 
      arithmetic-menu-item)|#